home *** CD-ROM | disk | FTP | other *** search
/ Info-Mac 3 / Info_Mac_1994-01.iso / Development / Source / IRC client Source / ircle sources / IRCIgnore.p < prev    next >
Encoding:
Text File  |  1993-01-16  |  4.6 KB  |  196 lines  |  [TEXT/PJMM]
  1. {    ircle - Internet Relay Chat client    }
  2. {    File: IRCIgnore    }
  3. {    Copyright © 1992 Olaf Titz (s_titz@ira.uka.de)    }
  4.  
  5. {    This program is free software; you can redistribute it and/or modify    }
  6. {    it under the terms of the GNU General Public License as published by    }
  7. {    the Free Software Foundation; either version 2 of the License, or    }
  8. {    (at your option) any later version.    }
  9.  
  10. {    This program is distributed in the hope that it will be useful,    }
  11. {    but WITHOUT ANY WARRANTY; without even the implied warranty of    }
  12. {    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the    }
  13. {    GNU General Public License for more details.    }
  14.  
  15. {    You should have received a copy of the GNU General Public License    }
  16. {    along with this program; if not, write to the Free Software    }
  17. {    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.    }
  18.  
  19. unit IRCIgnore;
  20. { Deals with the /ignore command }
  21.  
  22. interface
  23. uses
  24.     TCPTypes, TCPStuff, TCPConnections, ApplBase, MsgWindows, {}
  25.     IRCGlobals, IRCAux, IRCChannels;
  26.  
  27. procedure InitIRCIgnore;
  28. { Startup }
  29.  
  30. procedure DoIgnore (var s: string);
  31. { handles the /ignore command }
  32. { format: /ignore nick!user@host = ignore nick,user,host}
  33. {    /ignore nick, /ignore user@host do as well}
  34. {     wildcards are ? and * }
  35. {    /ignore +nick!user@host = ignore and give him notice }
  36. {    /ignore = list all ignorations }
  37. {    /ignore -nick!user@host = remove a tag }
  38.  
  39. function IsIgnored (var s: string; p: boolean): boolean;
  40. { handles messages from s - returns true if ignored. p=message may be answered }
  41.  
  42. implementation
  43.  
  44. const
  45.     DELV = chr(4);    { mark for rude ignore }
  46.     DELS = chr(5);    { mark for silent ignore }
  47.  
  48. var
  49.     ign: CharsHandle;
  50.     maxign: integer;
  51.  
  52. procedure ListIgnores;
  53.     var
  54.         s: string;
  55.         i: integer;
  56.     begin
  57.         i := 0;
  58.         s := '*** Ignore List: ';
  59.         while i < maxign do begin
  60.             if ign^^[i] = DELV then
  61.                 s := concat(s, '+');
  62.             repeat
  63.                 i := succ(i);
  64.                 if i >= maxign then
  65.                     leave;
  66.                 if ord(ign^^[i]) < 32 then
  67.                     leave;
  68.                 s := concat(s, ign^^[i]);
  69.             until false;
  70.             s := concat(s, ' ');
  71.         end;
  72.         LineMsg(s)
  73.     end;
  74.  
  75. procedure DoIgnore (var s: string);
  76.     var
  77.         tag: char;
  78.         i: integer;
  79.         p: string;
  80.     begin
  81.         while s[0] <> chr(0) do begin
  82.             NextArg(s, p);
  83.             if p[1] = '-' then begin
  84.                 i := Munger(Handle(ign), 0, @p[2], length(p) - 1, Ptr(1), 0);
  85.                 if i > 0 then
  86.                     i := Munger(Handle(ign), i - 1, nil, 1, Ptr(1), 0);
  87.                 maxign := maxign - length(p);
  88.             end
  89.             else begin
  90.                 if p[1] = '+' then
  91.                     p[1] := DELV
  92.                 else
  93.                     insert(DELS, p, 1);
  94.                 if pos('@', s) = 0 then
  95.                     p := concat(p, '!*@*')
  96.                 else if pos('!', s) = 0 then
  97.                     p := concat(p[1], '*!', copy(p, 2, 255));
  98.                 i := length(p);
  99.                 if PtrAndHand(@p[1], Handle(ign), i) = 0 then
  100.                     maxign := maxign + i;
  101.             end;
  102.         end;
  103.         ListIgnores
  104.     end;
  105.  
  106. procedure IgnoreBack (var s: string);
  107.     var
  108.         t: string;
  109.         i: integer;
  110.     begin
  111.         if serverStatus = 0 then begin
  112.             t := s;
  113.             i := pos('!', t);
  114.             if i > 0 then
  115.                 t[0] := chr(i - 1);
  116.             t := concat('NOTICE ', t, ' You are being ignored');
  117.             PutLine(t);
  118.         end;
  119.     end;
  120.  
  121. function upc (c: char): char;
  122.     begin
  123.         if (c >= 'a') and (c <= 'z') then
  124.             upc := chr(ord(c) - 32)
  125.         else
  126.             upc := c
  127.     end;
  128.  
  129. function IsIgnored (var s: string; p: boolean): boolean;
  130.     var
  131.         back: boolean;
  132.         a: integer;
  133.     function matchFrom (i, j: integer): boolean;
  134.         begin
  135.             matchFrom := true;
  136.             repeat
  137.                 if (ign^^[i] < ' ') and (s[j] < ' ') then
  138.                     exit(matchFrom);    { completely matched }
  139.                 if ign^^[i] = '*' then begin
  140.                     i := succ(i);
  141.                     if (i >= maxign) or (ign^^[i] < ' ') then
  142.                         exit(matchFrom); { pattern ended in * : matched }
  143.                     repeat
  144.                         while upc(s[j]) <> upc(ign^^[i]) do begin
  145.                             j := succ(j);
  146.                             if s[j] < ' ' then begin
  147.                                 matchFrom := false; { pattern ended *x , no match for x }
  148.                                 exit(matchFrom);
  149.                             end;
  150.                         end; { pattern *x, , match for x }
  151.                         if matchFrom(i, j) then { check for matching rest }
  152.                             exit(matchFrom);
  153.                         j := succ(j)
  154.                     until s[j] < ' '; { backtrack }
  155.                     matchFrom := false;
  156.                     exit(matchFrom);
  157.                 end
  158.                 else if (ign^^[i] <> '?') then begin
  159.                     if (upc(ign^^[i]) <> upc(s[j])) then begin
  160.                         matchFrom := false;    { Mismatch }
  161.                         exit(matchFrom)
  162.                     end;
  163.                 end;
  164.                 i := succ(i);
  165.                 j := succ(j);
  166.             until false;
  167.         end;
  168.     begin
  169.         s[length(s) + 1] := chr(0);
  170.         a := 0;
  171.         while a < maxign do begin
  172.             back := (ign^^[a] = DELV);
  173.             a := succ(a);
  174.             if matchFrom(a, 1) then begin
  175.                 IsIgnored := true;
  176.                 if p and back then
  177.                     IgnoreBack(s);
  178.                 exit(IsIgnored)
  179.             end;
  180.             repeat
  181.                 a := succ(a);
  182.                 if a >= maxign then
  183.                     leave;
  184.             until ign^^[a] < ' ';
  185.         end;
  186.         IsIgnored := false;
  187.     end;
  188.  
  189.  
  190. procedure InitIRCIgnore;
  191.     begin
  192.         ign := CharsHandle(NewHandle(0));
  193.         maxign := 0;
  194.     end;
  195.  
  196. end.